home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / c / genmo112.lha / GTB-Modula / GenModula / GenModula.mod < prev   
Encoding:
Text File  |  1993-09-28  |  9.5 KB  |  418 lines
  1. MODULE GenModula;
  2.  
  3. (*
  4.  * -------------------------------------------------------------------------
  5.  *
  6.  *    :Program.    GenModula
  7.  *    :Contents.    A Modula 2 Sourcecode generator for GadToolsBox
  8.  *
  9.  *    :Author.    Reiner B. Nix
  10.  *    :Address.    Geranienhof 2, 50769 Köln Seeberg
  11.  *    :Address.    rbnix@pool.informatik.rwth-aachen.de
  12.  *    :Copyright.    Reiner B. Nix
  13.  *    :Language.    Modula-2
  14.  *    :Translator.    M2Amiga A-L V4.2d
  15.  *    :Imports.    GadToolsBox, NoFrag  by Jaan van den Baard
  16.  *    :Imports.    InOut, NewArgSupport, Memory by Reiner Nix
  17.  *    :History.    this programm is a direct descendend from
  18.  *    :History.     OG (Oberon Generator) 37.11 by Thomas Igracki, Kai Bolay
  19.  *    :History.    GenModula 1.10 (23.Aug.93)    ;M2Amiga 4.0d
  20.  *    :History.    GenModula 1.12 (28.Sep.93)    ;M2Amiga 4.2d
  21.  *
  22.  * -------------------------------------------------------------------------
  23.  *)
  24.  
  25.  
  26.  
  27. FROM    GadToolsD        IMPORT    genericKind;
  28. FROM    FileOut            IMPORT    Write, WriteString, WriteLn,
  29.                     WriteCard, WriteInt, WriteHex;
  30. FROM    GadToolsBox        IMPORT    GadgetFlags, GadgetFlagSet,
  31.                     GuiFlags, GuiFlagSet,
  32.                     GenCFlags,
  33.                     GTConfigFlags, WindowTagFlags,
  34.                     ExtNewGadgetPtr, ProjectWindowPtr;
  35. IMPORT    InOut;
  36. FROM    GeneratorIO        IMPORT    dfile, mfile, args,
  37.                     Gui, MainConfig, CConfig, Projects,
  38.                     WriteFill, SeekBack;
  39. FROM    GenerateITexts        IMPORT    WriteITextsDefs,
  40.                     WriteITextsProcs, WriteITextsInits;
  41. FROM    GenerateMenus        IMPORT    WriteMenuConsts, WriteMenuDefs,
  42.                     WriteMenuProcs, WriteMenuInits;
  43. FROM    GenerateGadgets        IMPORT    WriteGadgetConsts, WriteGadgetDefs,
  44.                     WriteGadgetProcs, WriteGadgetInits;
  45. FROM    GenerateWindows        IMPORT    WriteWindowConsts, WriteWindowDefs,
  46.                     WriteWindowProcs, WriteWindowExit;
  47. FROM    GenerateScreen        IMPORT    WriteScreenDefs, WriteScreenProcs,
  48.                     WriteScreenInit, WriteScreenExit;
  49. FROM    GenerateGlobal        IMPORT    WriteGlobalDefs, WriteGlobalProcs;
  50.  
  51.  
  52.  
  53. (*
  54.  * --- Generate Projects --------------------------------------------------------
  55.  *)
  56. PROCEDURE WriteProjects;
  57.  
  58. VAR    pw            :ProjectWindowPtr;
  59.  
  60.  
  61.   PROCEDURE WriteStart;
  62.  
  63.   BEGIN
  64.   WriteLn (dfile);
  65.   WriteString (dfile, "(* ");
  66.   WriteString (dfile, pw^.name);
  67.   WriteString (dfile, " *) ");
  68.   WriteLn (dfile);
  69.  
  70.   WriteLn (mfile);
  71.   WriteString (mfile, "(* ");
  72.   WriteString (mfile, pw^.name);
  73.   WriteString (mfile, " *) ");
  74.   WriteLn (mfile);
  75.   END WriteStart;
  76.  
  77.  
  78.   PROCEDURE WriteConst;
  79.  
  80.   BEGIN
  81.   IF (pw^.gadgets.head^.succ # NIL) OR
  82.      (pw^.menus.head^.succ # NIL) THEN
  83.     WriteString (dfile, "CONST")
  84.     END;
  85.   WriteString (mfile, "CONST")
  86.   END WriteConst;
  87.  
  88.  
  89.   PROCEDURE WriteVar;
  90.  
  91.   BEGIN
  92.   IF (pw^.gadgets.head^.succ # NIL) OR
  93.      (pw^.menus.head^.succ # NIL) THEN
  94.     WriteLn (dfile);
  95.     END;
  96.   WriteLn (mfile);
  97.   WriteLn (mfile);
  98.  
  99.  
  100.   WriteString (dfile, "VAR");
  101.   WriteString (mfile, "VAR")
  102.   END WriteVar;
  103.  
  104.  
  105.   PROCEDURE WriteProcs;
  106.  
  107.   BEGIN
  108.   WriteLn (dfile);
  109.   WriteLn (mfile)
  110.   END WriteProcs;
  111.  
  112.  
  113.  
  114. (* WriteProject *)
  115. BEGIN
  116. WriteLn (mfile);
  117.  
  118. pw := Projects.head;
  119. WHILE pw^.succ # NIL DO
  120.   WriteStart;                    (* Comment precedes every project.    *)
  121.  
  122.   WriteConst;                    (* Project constants.            *)
  123.   WriteWindowConsts (pw);
  124.   WriteMenuConsts   (pw);
  125.   WriteGadgetConsts (pw);
  126.  
  127.   WriteVar;                    (* Project declarations.        *)
  128.   WriteWindowDefs   (pw);
  129.   WriteITextsDefs   (pw);
  130.   WriteMenuDefs     (pw);
  131.   WriteGadgetDefs   (pw);
  132.  
  133.   WriteProcs;
  134.   WriteITextsProcs  (pw);            (* Project procedures.            *)
  135.   WriteMenuProcs    (pw);
  136.   WriteGadgetProcs  (pw);
  137.   WriteWindowProcs  (pw);
  138.  
  139.   pw := pw^.succ
  140.   END
  141. END WriteProjects;
  142.  
  143.  
  144.  
  145. PROCEDURE WriteProjectsInit;
  146.  
  147. VAR    pw            :ProjectWindowPtr;
  148.  
  149. BEGIN
  150. pw := Projects.head;
  151. WHILE pw^.succ # NIL DO
  152.   WriteMenuInits   (pw);
  153.   WriteGadgetInits (pw);
  154.   WriteITextsInits (pw);
  155.  
  156.   pw := pw^.succ
  157.   END
  158. END WriteProjectsInit;
  159.  
  160.  
  161.  
  162. PROCEDURE WriteProjectsExit;
  163.  
  164. VAR    pw            :ProjectWindowPtr;
  165.  
  166. BEGIN
  167. pw := Projects.head;
  168. WHILE pw^.succ # NIL DO
  169.   WriteWindowExit (pw);
  170.  
  171.   pw := pw^.succ
  172.   END
  173. END WriteProjectsExit;
  174.  
  175.  
  176.  
  177. (*
  178.  * --- Codegenerierung Environment -----------------------------------------------
  179.  *)
  180. PROCEDURE WriteSource;
  181.  
  182. VAR    GetFilePresent        :BOOLEAN;
  183.  
  184.  
  185.  
  186.   PROCEDURE CheckGetFile    () :BOOLEAN;
  187.  
  188.   VAR    eng            :ExtNewGadgetPtr;
  189.       pw            :ProjectWindowPtr;
  190.  
  191.   BEGIN
  192.   pw := Projects.head;
  193.   WHILE pw^.succ # NIL DO
  194.     eng := pw^.gadgets.head;
  195.     WHILE eng^.succ # NIL DO
  196.       IF (eng^.kind = genericKind) THEN
  197.         RETURN TRUE
  198.         END;
  199.  
  200.       eng := eng^.succ
  201.       END;
  202.     pw := pw^.succ
  203.     END;
  204.  
  205.   RETURN FALSE
  206.   END CheckGetFile;
  207.  
  208.  
  209.  
  210.   PROCEDURE InitSource        (    GetFilePresent    :BOOLEAN);
  211.  
  212.  
  213.     (*$ CopyDyn := FALSE *)
  214.     PROCEDURE dW        (    text        :ARRAY OF CHAR);
  215.  
  216.     BEGIN
  217.     WriteString (dfile, text);
  218.     WriteLn (mfile)
  219.     END dW;
  220.  
  221.  
  222.     (*$ CopyDyn := FALSE *)
  223.     PROCEDURE mW        (    text        :ARRAY OF CHAR);
  224.  
  225.     BEGIN
  226.     WriteString (mfile, text);
  227.     WriteLn (mfile)
  228.     END mW;
  229.  
  230.  
  231.   (* InitSource *)
  232.   BEGIN
  233.   WriteString (dfile, "DEFINITION MODULE ");
  234.   WriteString (dfile, args.BaseName);
  235.   Write       (dfile, ";");
  236.   WriteLn (dfile);
  237.   WriteLn (dfile);
  238.  
  239.   dW ( "FROM IntuitionD            IMPORT    GadgetPtr, WindowPtr;            ");
  240.   WriteLn (dfile);
  241.   WriteLn (dfile);
  242.  
  243.  
  244.   WriteString (mfile, "IMPLEMENTATION MODULE ");
  245.   WriteString (mfile, args.BaseName);
  246.   Write       (mfile, ";");
  247.   WriteLn (mfile);
  248.   WriteLn (mfile);
  249.  
  250.   mW ( "FROM SYSTEM            IMPORT    LONGSET, ADDRESS,            ");
  251.   mW ( "                    ADR, TAG;                ");
  252.   mW ( "FROM Arts            IMPORT    Assert;                    ");
  253.   mW ( "FROM FileMessage        IMPORT    StrPtr;                    ");
  254.   mW ( "FROM ExecD            IMPORT    NodeType,                ");
  255.   mW ( "                    List, Node;                ");
  256.   mW ( "FROM ExecL            IMPORT    Forbid, Permit;                ");
  257.   mW ( "FROM GraphicsD            IMPORT    palMonitorID, ntscMonitorID,        ");
  258.   mW ( "                    superlaceKey, hireslaceKey, loresKey,    ");
  259.   mW ( "                    superKey, hiresKey,            ");
  260.   mW ( "                    DrawModes, DrawModeSet,            ");
  261.   mW ( "                    jam1, jam2,                ");
  262.   mW ( "                    FontStyles, FontStyleSet,        ");
  263.   mW ( "                    FontFlags, FontFlagSet,            ");
  264.   mW ( "                    TextAttr, TextAttrPtr,            ");
  265.   mW ( "                    TextFontPtr, RastPortPtr;        ");
  266.   mW ( "FROM GraphicsL            IMPORT    graphicsBase,                ");
  267.   mW ( "                    CloseFont,                ");
  268.   mW ( "                    SetAPen, TextLength,            ");
  269.   mW ( "                    RectFill;                ");
  270.   mW ( "FROM GfxMacros            IMPORT    SetAfPen;                ");
  271.   mW ( "FROM DiskFontL            IMPORT    OpenDiskFont;                ");
  272.   mW ( "FROM IntuitionD            IMPORT    customScreen,                ");
  273.   mW ( "                    WaTags,    GaTags, StringaTags, SaTags,    ");
  274.   mW ( "                    LayoutaTags, PgaTags,            ");
  275.   mW ( "                    ActivationFlags, ActivationFlagSet,    ");
  276.   mW ( "                    GadgetFlags, GadgetFlagSet,        ");
  277.   mW ( "                    PropInfoFlags, PropInfoFlagSet,        ");
  278.   mW ( "                    MenuItemFlags, MenuItemFlagSet,        ");
  279.   mW ( "                    WindowFlags, WindowFlagSet,        ");
  280.   mW ( "                    IDCMPFlags, IDCMPFlagSet,        ");
  281.   mW ( "                    ColorSpec, IntuiText,            ");
  282.   mW ( "                    GadgetPtr, ScreenPtr, ObjectPtr,    ");
  283.   mW ( "                    MenuPtr, WindowPtr;            ");
  284.   mW ( "FROM IntuitionL            IMPORT    NewObjectA, DisposeObject,        ");
  285.   mW ( "                    SetMenuStrip, ClearMenuStrip,        ");
  286.   mW ( "                    OpenWindowTagList, CloseWindow,        ");
  287.   mW ( "                    LockPubScreen, UnlockPubScreen,        ");
  288.   mW ( "                    OpenScreenTagList, CloseScreen,        ");
  289.   mW ( "                    PrintIText, IntuiTextLength,        ");
  290.   mW ( "                    AddGList, RemoveGList, RefreshGList;    ");
  291.   mW ( "FROM GadToolsD            IMPORT    nmTitle, nmItem, nmSub, nmEnd,        ");
  292.   mW ( "                    nmBarlabel,                ");
  293.   mW ( "                    genericKind, buttonKind, checkboxKind,    ");
  294.   mW ( "                    integerKind, listviewKind, mxKind,    ");
  295.   mW ( "                    numberKind, cycleKind, paletteKind,    ");
  296.   mW ( "                    scrollerKind, sliderKind, stringKind,    ");
  297.   mW ( "                    textKind,                ");
  298.   mW ( "                    buttonIDCMP, checkboxIDCMP, mxIDCMP,    ");
  299.   mW ( "                    integerIDCMP, listviewIDCMP, cycleIDCMP,");
  300.   mW ( "                    numberIDCMP, scrollerIDCMP, sliderIDCMP,");
  301.   mW ( "                    paletteIDCMP, stringIDCMP, textIDCMP,    ");
  302.   mW ( "                    arrowIDCMP,                ");
  303.   mW ( "                    GtTags,                    ");
  304.   mW ( "                    NewGadgetFlags, NewGadgetFlagSet,    ");
  305.   mW ( "                    NewMenu, NewGadget;            ");
  306.   mW ( "FROM GadToolsL            IMPORT    CreateContext,                ");
  307.   mW ( "                    CreateGadgetA, FreeGadgets,        ");
  308.   mW ( "                    GetVisualInfoA, FreeVisualInfo,        ");
  309.   mW ( "                    CreateMenusA, LayoutMenusA, FreeMenus,    ");
  310.   mW ( "                    DrawBevelBoxA,                 ");
  311.   mW ( "                    GTRefreshWindow,             ");
  312.   mW ( "                    GTBeginRefresh, GTEndRefresh;        ");
  313.   mW ( "FROM UtilityD            IMPORT    tagEnd,                    ");
  314.   mW ( "                    TagItem,                ");
  315.   mW ( "                    TagItemPtr;                ");
  316.  
  317.   IF GetFilePresent THEN
  318.     mW ("FROM GetFile            IMPORT    GetFileClass;                ");
  319.     END;
  320.  
  321.   WriteLn (mfile);
  322.   WriteLn (mfile)
  323.   END InitSource;
  324.  
  325.  
  326.  
  327.   PROCEDURE WriteVar;
  328.  
  329.   BEGIN
  330.   WriteLn (mfile);
  331.   WriteString (mfile, "VAR")
  332.   END WriteVar;
  333.  
  334.  
  335.  
  336.   PROCEDURE WriteInit;
  337.  
  338.   BEGIN
  339.   WriteLn (mfile);
  340.   WriteLn (mfile);
  341.   WriteString (mfile, "(* ");
  342.   WriteString (mfile, args.BaseName);
  343.   WriteString (mfile, " *)");
  344.   WriteLn (mfile);
  345.  
  346.   WriteString (mfile, "BEGIN");
  347.   WriteLn (mfile);
  348.   END WriteInit;
  349.  
  350.  
  351.  
  352.   PROCEDURE WriteExit;
  353.  
  354.   BEGIN
  355.   WriteLn (mfile);
  356.   WriteString (mfile, "CLOSE");
  357.   WriteLn (mfile)
  358.   END WriteExit;
  359.  
  360.  
  361.  
  362.   PROCEDURE ExitSource;
  363.  
  364.   BEGIN
  365.   WriteLn (dfile);
  366.   WriteLn (dfile);
  367.   WriteString (dfile, "END ");
  368.   WriteString (dfile, args.BaseName);
  369.   Write       (dfile, ".");
  370.   WriteLn (dfile);
  371.  
  372.   WriteString (mfile, "END ");
  373.   WriteString (mfile, args.BaseName);
  374.   Write       (mfile, ".");
  375.   WriteLn (mfile);
  376.   END ExitSource;
  377.  
  378.  
  379.  
  380. (* WriteSource *)
  381. BEGIN
  382. GetFilePresent := CheckGetFile ();
  383.  
  384.  
  385. InitSource (GetFilePresent);
  386.  
  387. WriteVar;
  388. WriteGlobalDefs (GetFilePresent);
  389. WriteScreenDefs;
  390.  
  391. WriteGlobalProcs;
  392. WriteScreenProcs (GetFilePresent);
  393.  
  394. WriteProjects;
  395.  
  396. WriteInit;
  397. WriteScreenInit;
  398. WriteProjectsInit;
  399.  
  400. WriteExit;
  401. WriteProjectsExit;
  402. WriteScreenExit;
  403.  
  404. ExitSource;
  405.  
  406.  
  407. InOut.WriteLn;
  408. InOut.WriteString ("GenModula completed successfull."); InOut.WriteLn;
  409. InOut.WriteLn
  410. END WriteSource;
  411.  
  412.  
  413.  
  414. (* GenModula *)
  415. BEGIN
  416. WriteSource
  417. END GenModula.
  418.